Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d12/emac16as.arc/EMACS.ASM

Assembly Source File | 1990-04-01 | 44KB | 2,208 lines

;History:1327,1
;Mon Mar 05 12:11:46 1990 Remove #(lk) and #(lr)
;Thu Feb 22 23:39:34 1990 make buffer-modified be a bitmap.
;Thu Feb 22 23:33:37 1990 add logical operators: || (or), && (and), ^^ (xor).
;Wed Feb 21 12:42:50 1990 auto_save should only be called on "real" input.
;Sat Oct 14 23:44:54 1989 in #(ex), if the stdout and stderr names are equal,redirect them to the same handle.
;Tue Sep 19 23:03:53 1989 Add support for Desqview.
;Sat Aug 19 23:25:22 1989 add ec_prim -- execution counts.
;Wed May 03 22:12:32 1989 Use a variable for the default bell pitch.
;Wed May 03 21:10:16 1989 don't 'and' the background color with 7.
;Tue Mar 07 23:58:36 1989 add parameters to #(bl)
;Tue Mar 07 23:33:36 1989 background colors are only three bits -- and them with 7.
;Mon Jan 30 22:49:56 1989 Add support for multiple colors.
;10-02-88 20:50:38 add a buffer for mouse clicks.
;10-01-88 14:50:07 make #(lv,ms) return four numbers.
;09-23-88 20:37:28 clean up auto_save
;09-18-88 23:13:35 Add "string index", si_prim
;09-18-88 12:32:52 use lowercase pathnames in #(lv,cd).
;09-12-88 23:40:00 if the buffer-modified flag is 2, then the buffer is read-only.
;09-10-88 05:44:35 Use bl instead of num_screen_cols in announce().
;09-10-88 05:40:21 try returning / when they try to find it.
;08-16-88 00:23:20 change auto save so it only count changes to a file.
;07-24-88 23:25:20 Put the third argument to #(an) *after* the cursor.
;07-19-88 00:17:27 Create 'li' primitive.
;05-15-88 19:58:02 Remove reference to non-existent init_memory [kdb]
;05-07-88 22:07:45 if stdout and stderr are redirected, don't bother swapping screens.
;04-17-88 22:47:53 add the ex redirect code.
;04-03-88 23:28:39 move the version number into another file.
;04-01-88 22:47:59 add tc variable.
;03-30-88 21:22:49 move xlat_to_mark to memory.asm
;03-30-88 20:48:45 add tr_prim
;03-27-88 19:47:54 add store_firstline and store_lastline
;03-26-88 15:53:35 put the variables in alphabetic order.
;03-26-88 14:24:12 expand the ?v_prim symbols to the two letter symbols.
;03-26-88 10:02:03 get rid of old single-letter variables.
;03-26-88 10:01:52 add auto-save counter
;03-23-88 23:56:09 Add variables 'fo' and 'bo' for original colors.
;03-13-88 12:27:10 remove #(ef)
;03-10-88 22:41:26 add #(l?)
;12-13-87 21:17:22
;11-26-87 11:45:11 fix goofyness in it_prim.
;09-09-87 00:49:51 after fixing redisp for the column redisplay bug, bump the version.
;07-15-87 22:10:51 up the version letter because I gave a copy to Pat.
;07-13-87 23:11:23 remove xyputch.
;07-13-87 23:00:03 move things around between files.
;07-10-87 23:09:06 add #(lv,vn) - version number.
;07-10-87 22:54:07 fix the problem with #(lv,xx) where xx is not a variable.
;07-10-87 00:23:10 remove trailing blank from #(sv,cd,...)
;07-10-87 00:17:28 add #(sv,cd,...)
;07-08-87 21:37:15 put a trailing \ on 'cd' variable.
;07-08-87 21:01:05 create the 'cd' variable.
;07-05-87 14:16:38 make complete paths in ff_prim an assembly-time option.
;07-05-87 14:02:28 compute the prefix length in ff_prim properly.
;07-05-87 11:55:54 Return full pathname and lowercase in ff_prim.
test_prims    equ    0
    page    ,132

    .xlist
    include    memory.def
    include    mint.def
    include    findfile.def

data    segment    byte public

    extrn    version_number: byte, version_number_len: abs

;the following externs are defined in 'mintprim'
    extrn    read_errors: word
    extrn    write_errors: word
    extrn    data_bottop: word
    extrn    data_topbot: word

;the following externs are defined in 'mintscan'
    extrn    fbgn: word, fend: word
    extrn    next_ids: word

;the following externs are defined in the computer-dependent file.
    extrn    max_screen_line: byte
    extrn    num_screen_cols: word
    extrn    computer_name: byte
    extrn    computer_name_len: abs

    public    filename, filename2
filename    db    64 dup(?)
filename2    db    64 dup(?)

rename_error    db    'Rename error'
rename_error_len    equ    $-rename_error

speller_txt    db    'Speller'
speller_txt_len    equ    $-speller_txt

    extrn    next_redisp_line: word

    public    standard_ids
standard_ids    db    '#(d,#(g))',0

nokbd_ids    db    '#(k)#(d,#(g))',0
auto_ids    db    '#(Fauto-save)',0

auto_save_limit    dw    0
auto_save_cntr    dw    0

byte_ptr    label    byte

color_list    label    byte
fore_color    db    7
back_color    db    0
control_color    db    2
whitespc_color    db    7

bell_pitch    dw    2000

ex_stdin    dw    ?        ;-1 if we're not redirecting.
ex_stdout    dw    ?        ;-1 if we're not redirecting.
ex_stderr    dw    ?        ;-1 if we're not redirecting.
    extrn    swap_screen_flag: word    ;=1 if we should swap screens.

    extrn    tab_size: word
    extrn    fore_original: byte
    extrn    back_original: byte

variable_table    label    byte
    db    'as'            ;Auto Save
    db    'bc'            ;Background Color
    db    'bl'            ;Bot Line
    db    'bo'            ;Background Original
    db    'bs'            ;Bot Scroll
    db    'cc'            ;Control Color
    db    'cd'            ;Current Directory
    db    'cl'            ;Line Number
    db    'cn'            ;Computer Name
    db    'cs'            ;Column on Screen
    db    'cw'            ;Current Window
    db    'bp'            ;Bell Pitch
    db    'fc'            ;Foreground Color
    db    'fo'            ;Foreground Original
    db    'im'            ;Inverse Mark
    db    'is'            ;Inhibit Snow
    db    'lc'            ;Lefthand Column
    db    'mb'            ;Modified Buffer
    db    'ms'            ;Mint Space
    db    'nl'            ;Number of Lines
    db    'ow'            ;Other Window
    db    'pb'            ;Percent of Buffer
    db    'rc'            ;Rightmost Column
    db    'rs'            ;Row on Screen
    db    'tc'            ;Tab Columns
    db    'tl'            ;Top Line
    db    'ts'            ;Top Scroll
    db    'vn'            ;Version Number
    db    'wc'            ;Whitespace Color
    db    'ws'            ;Whitespace Showing
variable_count    equ    ($-variable_table)/2

lv_prim_table    label    word
    dw    lv_prim_as
    dw    lv_prim_bc
    dw    lv_prim_bl
    dw    lv_prim_bo
    dw    lv_prim_bs
    dw    lv_prim_cc
    dw    lv_prim_cd
    dw    lv_prim_cl
    dw    lv_prim_cn
    dw    lv_prim_cs
    dw    lv_prim_cw
    dw    lv_prim_bp
    dw    lv_prim_fc
    dw    lv_prim_fo
    dw    lv_prim_im
    dw    lv_prim_is
    dw    lv_prim_lc
    dw    lv_prim_mb
    dw    lv_prim_ms
    dw    lv_prim_nl
    dw    lv_prim_ow
    dw    lv_prim_pb
    dw    lv_prim_rc
    dw    lv_prim_rs
    dw    lv_prim_tc
    dw    lv_prim_tl
    dw    lv_prim_ts
    dw    lv_prim_vn
    dw    lv_prim_wc
    dw    lv_prim_ws

sv_prim_table    label    word
    dw    sv_prim_as
    dw    sv_prim_bc
    dw    sv_prim_bl
    dw    sv_prim_bo
    dw    sv_prim_bs
    dw    sv_prim_cc
    dw    sv_prim_cd
    dw    sv_prim_cl
    dw    sv_prim_cn
    dw    sv_prim_cs
    dw    sv_prim_cw
    dw    sv_prim_bp
    dw    sv_prim_fc
    dw    sv_prim_fo
    dw    sv_prim_im
    dw    sv_prim_is
    dw    sv_prim_lc
    dw    sv_prim_mb
    dw    sv_prim_ms
    dw    sv_prim_nl
    dw    sv_prim_ow
    dw    sv_prim_pb
    dw    sv_prim_rc
    dw    sv_prim_rs
    dw    sv_prim_tc
    dw    sv_prim_tl
    dw    sv_prim_ts
    dw    sv_prim_vn
    dw    sv_prim_wc
    dw    sv_prim_ws

    extrn    stackp: byte

    public    trace_handle
trace_handle    dw    -1

sa_jump        dw    ?
sa_n_jump    dw    ?

mouse_buffer    dw    0        ;mouse button buffer.

  if timing
    public    counting
counting    db    0
    extrn    counts: word
    extrn    times: word
  endif

data    ends


code    segment    byte public
    assume    cs:code, ds:data, es:data

    extrn    set_screen_color: near

    extrn    redisplay: near        ;ax=line to leave the cursor on.

    extrn    buffer_free: near
    extrn    read_firstline: near
    extrn    read_lastline: near
    extrn    store_firstline: near
    extrn    store_lastline: near
    extrn    read_newrow: near
    extrn    read_linesbefore: near
    extrn    read_linecount: near
    extrn    read_buffer_modified: near
    extrn    store_buffer_modified: near
    extrn    read_ibm_cga: near
    extrn    store_ibm_cga: near
    extrn    read_inverse_mark: near
    extrn    store_inverse_mark: near

    extrn    read_showblanks: near
    extrn    store_showblanks: near

    extrn    read_top_percent: near
    extrn    read_bot_percent: near
    extrn    store_top_percent: near
    extrn    store_bot_percent: near

    extrn    read_other_window: near
    extrn    read_current_window: near
    extrn    store_other_window: near
    extrn    store_current_window: near

    extrn    chrout: near        ;al=char to overwrite to screen.

    extrn    paint_screen: near    ;sets entire screen to be repainted.

    extrn    paint_window: near    ;causes the current buffer to be shown in the current window.

    extrn    insert_string: near    ;si,cx describe the string.

    extrn    buffer_allocate: near    ;entry: cx=buffer number to select,
                    ;  cx=0 to create new buffer.
                    ;  ax=0 for read/write buffer.
                    ;exit: ax=new buffer number if enough
                    ;  memory, ax=0 otherwise.
    extrn    read_mark: near        ;entry: al=mark to read to.
                    ;exit: es:si, cx describing string.

    extrn    del_to_mark: near    ;entry: al=mark to delete to.

    extrn    set_mark: near        ;entry: al=dest mark, ah=source mark.

    extrn    goto_mark: near        ;entry: al=mark to go to.

    extrn    xlat_to_mark: near    ;entry: al=mark to translate to.
                    ;  es:bx = translate table,
                    ;  dx = length of translate table.

    extrn    stack_marks: near    ;entry: ax>0 to create temp marks,
                    ;  ax=0 to delete temp marks,
                    ;  ax<0 to create perm marks and delete
                    ;  all temp marks.

    extrn    compute_cursor: near    ;exit with dx=column (0..65535)

    extrn    set_column: near    ;entry: ax=desired column

    extrn    set_line: near        ;entry: ax=desired line.

    extrn    read_firstcolumn: near    ;get the left hand column.

    extrn    store_firstcolumn: near    ;set the left hand column.

    extrn    ring_the_bell: near


;the following extrns are in the computer-dependent file
    extrn    xychrout: near
    extrn    clear_count: near
    extrn    position_cursor: near
    extrn    check_for_key: near
    extrn    give_up_slice: near

;the following extrns are in 'files'
    extrn    read_file: near
    extrn    write_file: near

;the following extrns are in 'search'
    extrn    regexp_pat: near
    extrn    set_pattern: near
    extrn    search: near

;the following extrns are in 'mintscan'
    extrn    nomem: near

;the following externs are in 'pick'
    extrn    pick_on: near
    extrn    pick_off: near
    extrn    check_pick: near
    extrn    get_pick_values: near


    public    init_ids
init_ids:
    mov    sp,offset stackp
    call    check_for_key        ;use the standard ids only if kbd ready.
    jnz    init_ids_1
    mov    ax,offset nokbd_ids
init_ids_2:
    cmp    next_ids,offset standard_ids    ;only use a different one if
    jne    init_ids_1            ;we're at the standard ids.
    mov    next_ids,ax
init_ids_1:
    jmp    init_ids_continue

    extrn    init_ids_continue: near


write_protect:
    call    read_buffer_modified    ;see if this buffer is read-only.
    test    al,2
    jne    write_protect_1        ;yes - leave immediately.
    ret
write_protect_1:
    pop    ax            ;discard our return address.
    jmp    return_null


auto_save:
;preserve bp.
    mov    ax,auto_save_cntr    ;is the counter already at zero?
    or    ax,ax            ;is the counter already at zero?
    je    auto_save_1        ;yes - don't decrement it.
    dec    ax            ;time to auto-save?
    jne    auto_save_1        ;no.
    mov    ax,auto_save_limit    ;yes - reset the counter.
    mov    next_ids,offset auto_ids
auto_save_1:
    mov    auto_save_cntr,ax
    ret


    if    test_prims

;test primitive.  fills memory to the max.  strictly for testing only.
ts_prim:
    di_points_fbgn
    mov    cx,data_topbot
    sub    cx,di
    dec    cx
    push    cx
    mov    al,' '
    rep    stosb
    pop    cx
    jmp    return_sicx


formSeg    segment    public
;the following externs are defined in 'mintform'
    extrn    formhash: word
formSeg    ends

;dump formhash.  strictly for testing only.
tt_prim:
    mov    cx,256
    di_points_fbgn
    chk_room_cnt
    mov    si,offset formhash
tt_prim_1:
    test    cx,3fh
    jne    tt_prim_4
    mov    ax,LINENEW
    stosw
tt_prim_4:
    mov    dx,0
    lodsw
    mov    bx,ax
tt_prim_2:
    cmp    bx,NIL        ;at end of list yet?
    je    tt_prim_3
    mov    bx,[bx].hash_link
    inc    dx
    jmp    tt_prim_2
tt_prim_3:
    mov    ax,dx        ;get the count
    add    al,'0'        ;convert to ascii (cheaply)
    stosb
    loop    tt_prim_1
    jmp    return_tos

    endif

  if timing
ec_prim:
    call    getarg1
    jcxz    ec_prim_0

;zero out the old times.
    xor    bx,bx
    mov    cx,function_name_length
ec_prim_8:
    mov    counts[bx],0
    mov    times[bx],0
    add    bx,2
    loop    ec_prim_8

;now say that we're counting, and init the timer chip.
    mov    counting,1
    mov    al,34h
    out    43h,al
    jmp    short ec_prim_3
ec_prim_3:
    mov    al,0
    out    40h,al
    jmp    short ec_prim_4
ec_prim_4:
    mov    al,0
    out    40h,al
    jmp    return_null

ec_prim_0:
    xor    bx,bx
    mov    si,offset function_name_table
    di_points_fbgn
    mov    cx,function_name_length * (2 + 1 + 5 + 2)
    chk_room_cnt
    mov    cx,function_name_length
ec_prim_1:
    movsw
    mov    al,' '
    stosb

    push    bx
    push    cx

    push    times[bx]

    mov    ax,counts[bx]
    mov    cx,5            ;always use 5 digits.
    mov    bx,10
    call    put_number

    pop    ax

    cmp    counting,0        ;are we counting?
    je    ec_prim_7

    mov    byte ptr [di],' '
    inc    di

    mov    cx,5            ;always use 5 digits.
    mov    bx,10
    call    put_number

ec_prim_7:
    pop    cx
    pop    bx

    mov    times[bx],0        ;zero the counters.
    mov    counts[bx],0

    mov    al,CR
    stosb
    mov    al,LF
    stosb
    add    bx,2
    loop    ec_prim_1

    cmp    counting,0        ;restore the counter only if we were
    je    ec_prim_2        ;  counting.

    mov    al,36h
    out    43h,al
    jmp    short ec_prim_5
ec_prim_5:
    mov    al,0
    out    40h,al
    jmp    short ec_prim_6
ec_prim_6:
    mov    al,0
    out    40h,al

ec_prim_2:
    mov    counting,0
    jmp    return_tos
  endif


;redisplay.
rd_prim:
    call    getarg1
    jcxz    rd_prim_1
    call    paint_screen        ;paint,
    call    paint_window
    jmp    short rd_prim_3        ; always redisplay
rd_prim_1:
    call    check_for_key        ;redisplay only if no key waiting.
    jnz    rd_prim_2
rd_prim_3:
    call    redisplay
rd_prim_2:
    jmp    return_null


;overwrite the screen.
ow_prim:
    call    getarg1
    jcxz    ow_prim_2
ow_prim_1:
    lodsb
    xor    ah,ah
    call    chrout
    push    si
    push    cx
    pop    cx
    pop    si
    loop    ow_prim_1
ow_prim_2:
    jmp    return_null


    extrn    get_math: near
    extrn    gotoxy: near

;gotoxy
xy_prim:
    call    get_math
    mov    dh,al
    mov    dl,bl
    call    gotoxy
    jmp    return_null


;announce a string
an_prim:
    mov    bx,num_screen_cols    ;end of the line.
    mov    cx,2            ;if the second arg is non-null,
    mov    dh,0            ;start in this column
    call    getarg
    jcxz    an_prim_1
    call    read_lastline        ;  put the announcement after the current window.
    inc    al
    mov    dl,al
    call    announce1
    call    clear_count        ;clear to the end of the annunciator.
    jmp    return_null
an_prim_1:
    mov    dl,max_screen_line    ;get the row.
    inc    dl
    inc    dl            ;put our announcement after it.
    call    announce1        ;announce the left part.
    call    position_cursor        ;  put the cursor at the end of the string
    mov    cx,3            ;now announce the right part.
    call    announce
    call    clear_count        ;clear to the end of the annunciator.
    jmp    return_null


announce1:
    mov    cx,1
announce:
;given an argument in cx, print it at row=dl, column=dh.
    call    getarg
    jcxz    announce_2        ;if null, we';re done.
announce_1:
    cmp    dh,bl            ;end of the line.
    jae    announce_2        ;if we hit end of line, we're done.
    lodsb                ;get a character.
    mov    ah,0
    call    xychrout
    inc    dh
    loop    announce_1
announce_2:
    ret


;insert a string.
is_prim:
    call    write_protect
    call    getarg1
    call    insert_string
    jc    is_prim_1        ;go if we can't insert it.
    jmp    return_null
is_prim_1:
    mov    cx,2
    jmp    return_arg


    extrn    get_mint_space: near

lv_prim:
;load variable
    mov    bx,offset lv_prim_table
    call    parse_variable
    di_points_fbgn
    jmp    word ptr [bx]

lv_prim_cd:
    mov    cx,64+3            ;we need at most 64 plus 'a:\'.
    chk_room_cnt
    mov    ah,19h            ;get the current drive.
    int    21h
    mov    dl,al
    inc    dl
    add    al,'a'
    stosb
    mov    ax,':' + '\'*256
    stosw

    mov    si,di            ;get the directory here.
    mov    ah,47h            ;get current directory.
    int    21h
lv_prim_cd_1:                ;find the terminating null.
    lodsb
    call    to_lower        ;lowercase the filename.
    mov    [si-1],al
    or    al,al
    jne    lv_prim_cd_1
    dec    si
    xchg    di,si            ;di should point to the null.

    cmp    si,di            ;are we in a subdirectory?
    je    lv_prim_cd_2
    mov    al,'\'            ;yes - store a trailing backslash.
    stosb
lv_prim_cd_2:
    jmp    return_tos


lv_prim_vn:
    mov    si,offset version_number
    mov    cx,version_number_len
    chk_room_cnt
    rep    movsb
    jmp    return_tos


lv_prim_cn:
    mov    si,offset computer_name
    mov    cx,computer_name_len
    chk_room_cnt
    rep    movsb
    jmp    return_tos


lv_prim_im:
    call    read_inverse_mark
    stosb
    jmp    return_tos

lv_prim_pb:
    call    read_linecount
    inc    ax
    push    ax
    call    read_linesbefore
    inc    ax
    mov    dx,100
    mul    dx
    pop    cx
    div    cx
    jmp    return_number

lv_prim_ms:
    mov    cx,6*4
    chk_room_cnt
    call    get_mint_space
    jmp    return_tos

lv_prim_bp:
    mov    ax,bell_pitch
    jmp    return_number

lv_prim_fc:
    mov    ah,0
    mov    al,fore_color
    jmp    return_number

lv_prim_bc:
    mov    ah,0
    mov    al,back_color
    jmp    return_number

lv_prim_cc:
    mov    ah,0
    mov    al,control_color
    jmp    return_number

lv_prim_wc:
    mov    ah,0
    mov    al,whitespc_color
    jmp    return_number

lv_prim_fo:
    mov    ah,0
    mov    al,fore_original
    jmp    return_number

lv_prim_bo:
    mov    ah,0
    mov    al,back_original
    jmp    return_number

lv_prim_ow:
    call    read_other_window
    jmp    return_number

lv_prim_cw:
    call    read_current_window
    jmp    return_number

lv_prim_ts:
    call    read_top_percent
    mov    ah,0
    jmp    return_number
lv_prim_bs:
    call    read_bot_percent
    mov    ah,0
    jmp    return_number
lv_prim_ws:
    call    read_showblanks
    inc    ax
    jmp    return_number
lv_prim_nl:
    call    read_linecount
    inc    ax
    jmp    return_number
lv_prim_rc:
    mov    ax,num_screen_cols
    inc    ax
    jmp    return_number
lv_prim_rs:
    call    read_newrow
    inc    ax
    jmp    return_number
lv_prim_cs:
    call    compute_cursor
    mov    ax,dx
    inc    ax
    jmp    return_number
lv_prim_lc:
    call    read_firstcolumn
    inc    ax
    jmp    return_number
lv_prim_tc:
    mov    ax,tab_size
    inc    ax
    jmp    return_number
lv_prim_tl:
    call    read_firstline
    mov    ah,0
    inc    ax
    jmp    return_number
lv_prim_bl:
    call    read_lastline
    mov    ah,0
    inc    ax
    jmp    return_number
lv_prim_mb:
    call    read_buffer_modified
    mov    ah,0
    jmp    return_number
lv_prim_is:
    call    read_ibm_cga
    mov    ah,0
    jmp    return_number
lv_prim_as:
    mov    ax,auto_save_limit
    jmp    return_number
lv_prim_cl:
    call    read_linesbefore
    inc    ax
    jmp    return_number


sv_prim:
;store variable
    mov    bx,offset sv_prim_table
    call    parse_variable
    push    bx
    mov    cx,2
    call    get_decimal_arg
    pop    bx
    call    word ptr [bx]
    jmp    return_null

sv_prim_bp:
    mov    bell_pitch,ax
    ret


sv_prim_fc:
    mov    fore_color,al
    mov    si,offset color_list
    call    set_screen_color
    ret

sv_prim_bc:
    mov    back_color,al
    mov    si,offset color_list
    call    set_screen_color
    ret

sv_prim_cc:
    mov    control_color,al
    mov    si,offset color_list
    call    set_screen_color
    ret


sv_prim_wc:
    mov    whitespc_color,al
    mov    si,offset color_list
    call    set_screen_color
    ret


sv_prim_ow:
    call    store_other_window
    ret

sv_prim_cw:
    call    store_current_window
    ret

sv_prim_ts:
    call    store_top_percent
    ret
sv_prim_bs:
    call    store_bot_percent
    ret
sv_prim_ws:
    call    store_showblanks    ;whitespace.
    ret
sv_prim_im:
    mov    cx,2
    call    getarg_mark
    call    store_inverse_mark
    ret
sv_prim_cd:
    mov    cx,2            ;get the "filename" into filename.
    call    getarg_filename
    mov    ax,[si]            ;get the first two chars.
    or    al,al            ;do we have anything at all?
    je    sv_prim_cd_1        ;no.
    cmp    ah,':'            ;is the second char ':'?
    jne    sv_prim_cd_2        ;no.
    add    si,2            ;parse past these characters.
    call    to_lower        ;convert the drive character to lowercase.
    sub    al,'a'
    mov    ah,0eh            ;select drive
    mov    dl,al
    int    21h
sv_prim_cd_2:
    mov    dx,si            ;save a copy and find the first null.
sv_prim_cd_3:
    lodsb
    or    al,al
    jne    sv_prim_cd_3
    sub    si,2            ;make si -> last char of path.
    cmp    si,dx            ;is this a one character subdir?
    je    sv_prim_cd_4        ;yes - don't strip trailing slashes.
    xor    al,al
    xchg    al,[si]            ;store a null there.
    cmp    al,'\'            ;was it a backslash?
    je    sv_prim_cd_4        ;yes.
    cmp    al,'/'            ;was it a slash?
    je    sv_prim_cd_4        ;yes.
    mov    [si],al            ;no - store the original char.
sv_prim_cd_4:
    mov    ah,3bh            ;change to this directory.
    int    21h
sv_prim_cd_1:
    ret

sv_prim_tc:
    cmp    ax,2
    je    sv_prim_tc_1
    cmp    ax,4
    je    sv_prim_tc_1
    cmp    ax,8
    je    sv_prim_tc_1
    cmp    ax,16
    jne    sv_prim_tc_2
sv_prim_tc_1:
    dec    ax
    mov    tab_size,ax
    call    paint_screen
sv_prim_tc_2:
    ret

sv_prim_tl:
    dec    ax
    call    store_firstline
    ret

sv_prim_bl:
    dec    ax
    call    store_lastline
    ret

sv_prim_fo:
sv_prim_bo:
sv_prim_vn:
sv_prim_cn:
sv_prim_pb:
sv_prim_ms:
sv_prim_nl:
sv_prim_rc:
    ret
sv_prim_rs:
    mov    next_redisp_line,ax
    ret
sv_prim_cs:
    call    set_column
    ret
sv_prim_lc:
    dec    ax
    call    store_firstcolumn
    ret
sv_prim_mb:
    call    store_buffer_modified
    ret
sv_prim_is:
    call    store_ibm_cga
    ret
sv_prim_as:
    mov    auto_save_limit,ax
    mov    auto_save_cntr,ax
    ret
sv_prim_cl:
    call    set_line
    ret




parse_variable:
;parse a variable letter.
;return bx -> proper entry in the table pointed to by bx on entry.
;the default is at the end of the table.
    call    getarg1
    mov    ax,'l'            ;defaults to line
    jcxz    parse_variable_1
    lodsb
    dec    cx
    je    parse_variable_1
    mov    ah,[si]
parse_variable_1:
    mov    di,offset variable_table
    mov    cx,variable_count
    repne    scasw
    sub    cx,variable_count-1
    neg    cx
    shl    cx,1
    add    bx,cx
    ret


pp_prim:
    di_points_fbgn
    mov    cx,11            ;make sure there's enough room.
    chk_room_cnt
    call    get_pick_values
    push    dx            ;save vertical
    mov    ax,cx
    mov    cx,0
    mov    bx,10
    call    put_number
    mov    al,','
    stosb
    pop    ax            ;pushed as dx
    jmp    return_number


sa_prim:
    mov    di,fend            ;make di point to some free memory.
    add    di,2
    mov    si,fbgn            ;point si at "sa".
    mov    si,[si]            ;point si at the first arg.
    mov    dx,0            ;count the arguments here.
sa_prim_1:
    cmp    si,[si]            ;are we pointing at fend?
    je    sa_prim_2
    mov    [di],si            ;save a pointer to the argument.
    add    di,2
    chk_room
    mov    si,[si]            ;make it point to next arg.
    inc    dx
    jmp    sa_prim_1
sa_prim_2:
;dx=number of arguments.
;fend+2->argument pointers.

    mov    bx,fend            ;make bx point to some free memory.
    add    bx,2

    mov    sa_jump,dx
    dec    dx

loop1:
    cmp    sa_jump,1        ;is JUMP > 1?
    jbe    sa_prim_4        ;no - sort complete
    shr    sa_jump,1        ;JUMP = JUMP DIV 2

loop2:
    mov    bp,1            ;set DONE = TRUE
    mov    ax,dx            ;get N
    sub    ax,sa_jump        ;compute N - JUMP
    mov    sa_n_jump,ax        ;store N - JUMP
    mov    cx,0
                    ;for J = 1 to N - JUMP DO
loop3:
    mov    si,bx
    add    si,cx            ;make si -> a[J]
    add    si,cx
    mov    di,si
    add    di,sa_jump        ;offset I by JUMP
    add    di,sa_jump


    push    cx

    push    si
    push    di

    mov    si,[si]            ;get the two arguments under consideration.
    mov    di,[di]

    mov    ax,[si]            ;compute length of this arg.
    sub    ax,si
    sub    ax,mark_overhead
    add    si,mark_overhead-1    ;make si=> text of argument.

    mov    cx,[di]            ;compute length of this arg.
    sub    cx,di
    sub    cx,mark_overhead
    add    di,mark_overhead-1    ;make si=> text of argument.

    cmp    ax,cx            ;if the first string is shorter,
    jb    sa_prim_8        ;  return if if they're equal.
                    ;second string is smaller.
    push    cx
    repe    cmpsb            ;compare the two strings
    pop    cx
    pop    di
    pop    si
    jb    sa_prim_5        ;go if they're in order already.
    ja    sa_prim_6        ;if they're not in order, swap them.
    cmp    ax,cx            ;were the strings equal?
    je    sa_prim_5        ;yes - don't swap them.
    jmp    short sa_prim_6

sa_prim_8:
    xchg    cx,ax            ;first string is smaller.
    repe    cmpsb            ;compare the two strings
    pop    di
    pop    si
    jbe    sa_prim_5        ;go if they're in order already.

sa_prim_6:
    mov    ax,[si]            ;swap them.
    xchg    ax,[di]
    mov    [si],ax
    mov    bp,0            ;set DONE = FALSE
sa_prim_5:
    pop    cx            ;get the counter back.
    inc    cx            ;bump the counter
    cmp    cx,sa_n_jump        ;is cx = N - JUMP?
    jbe    loop3            ;if cycle not complete, go again
    cmp    bp,0            ;is DONE = FALSE
    je    loop2            ;no, another cycle
    jmp    loop1            ;keep going until sort is complete

sa_prim_4:
    inc    dx            ;because we 'dec'ed it before.
    mov    bx,fend            ;make bx point to some free memory.
    add    bx,2
    mov    di,bx            ;compute the end of the table.
    add    di,dx
    add    di,dx
    push    di
sa_prim_7:
    mov    si,[bx]
    add    bx,2
    mov    cx,[si]            ;compute length of this arg.
    sub    cx,si
    sub    cx,mark_overhead
    add    si,mark_overhead-1    ;make si=> text of argument.
    inc    cx            ;include space for the comma.
    chk_room_cnt
    dec    cx
    rep    movsb
    mov    al,','            ;comma terminate the strings.
    stosb

    dec    dx            ;done with all of them?
    jne    sa_prim_7        ;no - do another.

    jmp    return_tos


bl_prim:
    call    get_decimal_arg1
    push    ax
    mov    cx,2
    call    get_decimal_arg
    mov    cx,ax
    pop    bx
    or    bx,bx            ;Do they want the default?
    jne    bl_prim_1        ;no.
    mov    bx,bell_pitch        ;yes.
bl_prim_1:
    call    ring_the_bell
    jmp    return_null


;push/pop marks
pm_prim:
    call    get_decimal_arg1
    call    stack_marks
    jc    pm_prim_1
    jmp    return_null
pm_prim_1:
    mov    cx,2
    jmp    return_arg_active


;set mark (to point)
sm_prim:
    mov    cx,2
    call    getarg_mark
    mov    al,'.'        ;if 2nd is missing, use '.'
    jcxz    sm_prim_1
    lodsb
sm_prim_1:
    mov    ah,al        ;get source mark
    push    ax        ;save source mark
    call    getarg_mark1
    pop    bx        ;pushed as ax
    mov    ah,bl        ;get dest mark
    call    set_mark
    jmp    return_null


;set point (to marks)
sp_prim:
    mov    cx,1
    call    getarg
    jcxz    sp_prim_1
sp_prim_2:
    lodsb
    push    si
    push    cx
    call    goto_mark
    pop    cx
    pop    si
    loop    sp_prim_2
sp_prim_1:
    jmp    return_null


;delete to mark
dm_prim:
    call    write_protect
    call    getarg1
    jcxz    dm_prim_1
dm_prim_2:
    lodsb
    push    si
    push    cx
    call    del_to_mark
    pop    cx
    pop    si
    loop    dm_prim_2
dm_prim_1:
    jmp    return_null


;read to mark
rm_prim:
    call    getarg_mark1    ;get mark number to read from.
    call    read_mark    ;returns es:si, cx describing string.
    assume    ds:nothing
    di_points_fbgn
;    chk_room_cnt
    mov    ax,es
    call    buffer_free    ;make sure that there's that much room.
    jc    rm_prim_1    ;if cy, there must be no room.
    rep    movsb        ;move the string.
    push    es        ;restore our ds.
    pop    ds
    jmp    return_tos
rm_prim_1:
    add    sp,2        ;conserve the stack.
    push    es        ;restore our ds.
    pop    ds
    assume    ds:data
    mov    cx,2
    jmp    return_arg_active


;translate characters.
tr_prim:
    call    write_protect
    mov    cx,2        ;translate according to arg 2.
    call    getarg
    push    si
    push    cx
    call    getarg_mark1    ;get mark number to read from.
    pop    dx
    pop    bx
    call    xlat_to_mark
    jmp    return_null


;count to mark
rc_prim:
    call    getarg_mark1    ;get mark number to read from.
    call    read_mark    ;returns ds:si, cx describing string.
    push    es        ;restore our ds.
    pop    ds
    mov    ax,cx
    di_points_fbgn
    jmp    return_number


;spell check
sc_prim:
    push    ds
    xor    ax,ax
    mov    ds,ax
    lds    si,ds:[4*82h]        ;get the speller's interrupt.
    sub    si,speller_txt_len+2    ;backup past the string and version.
    mov    di,offset speller_txt
    mov    cx,speller_txt_len    ;see if the speller is installed.
    repe    cmpsb
    pop    ds

    mov    ax,-1            ;if no speller, return -1.
    jne    sc_prim_1        ;no speller.

    call    getarg1_filename
    push    si
    mov    cx,2
    call    get_decimal_arg
    mov    ah,al
    pop    si            ;get the pointer to the word.
    int    82h
sc_prim_1:
    di_points_fbgn
    jmp    return_number


;mark before point #(mb,mark,before,after)
mb_prim:
    call    getarg_mark1
    call    read_mark
    push    es        ;restore our ds.
    pop    ds
    jc    mb_prim_1    ;go if point is before mark
    mov    cx,2
    jmp    return_arg
mb_prim_1:
    mov    cx,3
    jmp    return_arg



;look pattern.  return arg 2 if bad pattern.
lp_prim:
    mov    cx,3            ;see if we should be regular or not.
    call    getarg
    mov    dx,cx            ;remember it.
    mov    cx,4            ;see if we should fold case or not.
    call    getarg
    mov    di,cx            ;remember it.
    call    getarg1
    call    set_pattern
    jc    lp_prim_1
    jmp    return_null
lp_prim_1:
    mov    cx,2
    jmp    return_arg_active


;look for a string.  return arg 5 if found, arg 6 if not.
lt_prim:
    call    getarg_mark1
    push    ax
    mov    cx,2
    call    getarg_mark
    push    ax
    mov    cx,3
    call    getarg_mark
    push    ax
    mov    cx,4
    call    getarg_mark
    mov    dl,al        ;set arg 4 (last)
    pop    ax        ;restore arg 3 (first)
    mov    dh,al
    pop    cx        ;restore arg 2 (end) pushed as ax.
    pop    ax        ;restore arg 1 (start)
    mov    ch,al
    call    search
    mov    cx,5        ;if we found it, return arg 5.
    jnc    lt_prim_1
    mov    cx,6        ;else return arg 6.
lt_prim_1:
    jmp    return_arg


;find the first and next occurrences of a file.
ff_prim:
    mov    dx,offset filename2
    mov    ah,1ah
    int    21h
    call    getarg1_filename
    mov    dx,si            ;remember the filename for find_first.

    di_points_fend
    mov    ax,[si]
    cmp    ah,':'            ;does this filename have a drive?
    jne    ff_prim_9        ;no.
    mov    ax,[si+2]        ;yes - skip it.
ff_prim_9:
    cmp    ax,'/'            ;are they referring to root?
    je    ff_prim_a
    cmp    ax,'\'
    jne    ff_prim_b
ff_prim_a:
    mov    cx,5
    chk_room_cnt
ff_prim_8:
    lodsb
    cmp    al,'/'
    jne    ff_prim_c
    mov    al,'\'
ff_prim_c:
    stosb
    or    al,al
    jne    ff_prim_8
    dec    di

    mov    cx,2            ;copy the separator argument.
    call    getarg
    chk_room_cnt
    rep    movsb

    jmp    return_tos

ff_prim_b:
    mov    ah,4eh            ;find first matching file
    mov    cx,10h            ;find subdirs, too.
ff_prim_1:
    int    21h            ;find first or find next.
    jnc    ff_prim_2        ;more files...
    jmp    return_tos
ff_prim_2:

    mov    si,offset filename2.find_buf_name
    mov    ah,0
ff_prim_3:
    lodsb
    or    al,al
    je    ff_prim_4
    cmp    al,'.'            ;remember if we got a '.'.
    jne    ff_prim_6
    inc    ah
ff_prim_6:
    call    to_lower
    chk_room
    stosb
    jmp    ff_prim_3
ff_prim_4:

    test    filename2.find_buf_attr,10h    ;is this a subdir?
    je    ff_prim_5        ;no.
    mov    al,'\'            ;yes- store a trailing backslash.
    chk_room
    stosb
    jmp    short ff_prim_7        ;don't consider storing '.'.
ff_prim_5:
    or    ah,ah            ;did we find a '.'?
    jne    ff_prim_7
    mov    al,'.'            ;no - store a trailing '.'.
    stosb
ff_prim_7:

    mov    cx,2            ;copy the separator argument.
    call    getarg
    chk_room_cnt
    rep    movsb

    mov    ah,4fh            ;find next.
    jmp    ff_prim_1


to_lower:
    cmp    al,'A'            ;uppercase?
    jb    to_lower_1
    cmp    al,'Z'
    ja    to_lower_1
    add    al,'a'-'A'        ;use uppercase.
to_lower_1:
    ret


;rename a file.
rn_prim:
    call    getarg1_filename
    mov    cx,2
    call    getarg
    mov    di,offset filename2
    rep    movsb
    xor    al,al
    stosb
    mov    dx,offset filename
    mov    di,offset filename2
    mov    ah,56h            ;rename file
    int    21h
    jnc    rn_prim_1
    mov    si,offset rename_error
    mov    cx,rename_error_len
    jmp    return_sicx
rn_prim_1:
    jmp    return_null


;delete a file.
de_prim:
    call    getarg1_filename
    mov    dx,si
    mov    ah,41h            ;delete file
    int    21h
    jnc    de_prim_1
    mov    al,2
    mov    bx,offset read_errors
    jmp    return_string
de_prim_1:
    jmp    return_null


;read a file
rf_prim:
    call    write_protect
    call    getarg1_filename
    call    read_file
    mov    bx,offset read_errors
    jmp    return_string


;write a file.
wf_prim:
    call    getarg1_filename
    push    si            ;preserve the pointer to the filename.
    mov    cx,2
    call    getarg_mark
    pop    si
    call    write_file
    mov    bx,offset write_errors
    jmp    return_string


;allocate a buffer
ba_prim:
    call    get_decimal_arg1
    push    ax
    mov    cx,2
    call    getarg
    mov    ax,cx
    pop    cx            ;pushed as ax.
    call    buffer_allocate
    di_points_fbgn
    jmp    return_number


;insert from a buffer
;#(bi,buffer number,mark,yes,no)
bi_prim:
    call    write_protect
    call    get_decimal_arg1    ;get the buffer number.
    push    ax
    mov    cx,2            ;get the mark.
    call    getarg_mark
    pop    cx
    call    buffer_insert
    jc    bi_prim_1        ;go if we can't insert it.
    mov    cx,3
    jmp    return_arg
bi_prim_1:
    mov    cx,4
    jmp    return_arg


ao_prim:
    call    getarg1        ;get the first argument
    mov    dx,cx        ;save size of first argument
    mov    di,si        ;save pointer to first argument
    mov    cx,2        ;get second argument
    call    getarg
    cmp    cx,dx        ;second shorter than first?
    jb    ao_prim_2    ;yes - use second's length.
    mov    cx,dx        ;no - use first's length.
    repe    cmpsb        ;strings alphabetically ordered?
    jb    ao_prim_4    ;no, return 4th.
    jmp    short ao_prim_3
ao_prim_2:
    repe    cmpsb        ;strings alphabetically ordered?
    jbe    ao_prim_4    ;no, return 4th.
ao_prim_3:
    mov    cx,3
    jmp    return_arg
ao_prim_4:
    mov    cx,4
    jmp    return_arg


it_prim:
;check for key, timed.
    call    get_decimal_arg1
    mov    bp,ax            ;save the wait time.
    or    ax,ax            ;are they really waiting for a char?
    je    it_prim_0        ;go if not.
    call    auto_save
it_prim_0:

    call    check_for_key        ;character waiting?
    jne    it_prim_1        ;yes - don't turn the pick on.
    call    pick_on
    call    input_timed
    push    ax            ;preserve the key value.
    call    pick_off
    pop    ax
    jmp    short it_prim_2
it_prim_1:
    call    input_timed
it_prim_2:
    call    decode_key        ;no - change the key into a string.
    di_points_fbgn
it_prim_3:
    lodsb
    or    al,al
    je    it_prim_4
    chk_room
    stosb
    jmp    it_prim_3
it_prim_4:
    jmp    return_tos


input_timed:
    xor    ax,ax            ;check the mouse buffer first.
    xchg    ax,mouse_buffer
    or    ax,ax
    jne    input_timed_5        ;got one - see if we should restuff it.

    xor    si,si            ;si is the elapsed time.
    mov    ah,2ch            ;get the current hundreths.
    int    21h
    mov    bl,dl
input_timed_1:
    call    check_for_key        ;character waiting?
    jne    input_timed_2        ;yes - return it.
    call    check_pick        ;pick waiting?
    jne    input_timed_5        ;yes - return it.
    call    give_up_slice
    mov    ah,2ch            ;gtime
    int    21h
    mov    al,dl            ;subtract the new time from the old.
    sub    al,bl
    mov    bl,dl            ;update the time in bl.
    cbw
    jns    input_timed_4        ;go if it's positive.
    add    ax,100            ;make it positive.
input_timed_4:
    add    si,ax            ;add in to the current time.
    cmp    si,bp            ;time to timeout yet?
    jb    input_timed_1        ;no.
    mov    ax,255            ;yes - timeout.
    jmp    short input_timed_3
input_timed_5:
    or    bp,bp            ;original wait time.
    jnz    input_timed_3        ;if non zero wait, we're inputting it.
    mov    mouse_buffer,ax        ;store the mouse button in a buffer.
    jmp    short input_timed_3
input_timed_2:
    or    bp,bp            ;original wait time.
    jz    input_timed_3        ;if zero wait, we're just checking.
    call    get_key_value
input_timed_3:
    ret


bc_prim:
    mov    cx,2        ;get 'from' argument.
    call    getarg
    mov    dl,'a'        ;default to ASCII
    jcxz    bc_prim_1
    mov    dl,[si]        ;get from type.
bc_prim_1:
    mov    cx,3        ;get 'to' argument.
    call    getarg
    mov    dh,'d'        ;default to decimal
    jcxz    bc_prim_2
    mov    dh,[si]
bc_prim_2:
    call    getarg1
    call    bc_prim_base    ;get the source base.
    or    bx,bx        ;ASCII?
    jnz    bc_prim_4    ;no.
    jcxz    bc_prim_6
    lodsb
    mov    ah,0
    jmp    bc_prim_3
bc_prim_6:
    mov    ax,-1        ;if ASCII, and null argument, use -1.
    jmp    bc_prim_3
bc_prim_4:
    push    dx        ;preserve dx.
    call    get_number
    pop    dx
bc_prim_3:
;we now have the number in ax.
    mov    dl,dh
    call    bc_prim_base
    di_points_fbgn
    or    bx,bx
    jnz    bc_prim_5
    stosb
    jmp    return_tos
bc_prim_5:
    mov    cx,0        ;use only as many digits as are needed.
    call    put_number
    jmp    return_tos


;private subroutine, used only bc_prim.
bc_prim_base:
;enter with dl=base character.
;exit with bx=base if number; bx=0 if ASCII.
    or    dl,20h        ;convert UPPER case to lower case.
    cmp    dl,'d'
    jne    bc_prim_base_1
    mov    bx,10
    ret
bc_prim_base_1:
    cmp    dl,'o'
    jne    bc_prim_base_2
    mov    bx,8
    ret
bc_prim_base_2:
    cmp    dl,'h'
    jne    bc_prim_base_3
    mov    bx,16
    ret
bc_prim_base_3:
    cmp    dl,'c'
    jne    bc_prim_base_4
    mov    bx,0
    ret
bc_prim_base_4:
    cmp    dl,'a'        ;a alias character.
    jne    bc_prim_base_5
    mov    bx,0
    ret
bc_prim_base_5:
    cmp    dl,'b'
    jne    bc_prim_base_6
    mov    bx,2
    ret
bc_prim_base_6:
    ret


getarg_mark1:
    mov    cx,1
getarg_mark:
;enter with cx=arg number.
;exit with al=mark, cx=arg size, si->arg.
    call    getarg
    mov    al,0        ;use null if no string specified.
    jcxz    getarg_mark_1
    mov    al,[si]        ;get the first character
getarg_mark_1:
    ret


    public    trace_result
trace_result:
;enter with si->, cx=count of returning result of a primitive call.
;doesn't modify si or cx.
    push    bx
    push    cx
    push    si
    mov    bx,trace_handle
    or    bx,bx
    js    trace_result_3
    mov    al,'{'
    call    printchar
    jcxz    trace_result_1
trace_result_2:
    lodsb
    call    printchar
    loop    trace_result_2
trace_result_1:
    mov    al,'}'
    call    printchar
    mov    al,CR
    call    printchar
    mov    al,LF
    call    printchar
    mov    ah,7
    int    21h
trace_result_3:
    pop    si
    pop    cx
    pop    bx
    ret


neutral_marker    equ    3

    public    trace_invoke
trace_invoke:
;enter with bx->fbgn, al=function type (active or neutral)
    push    bx
    push    dx
    push    di
    mov    di,bx
    mov    bx,trace_handle
    or    bx,bx
    js    trace_result_3
    cmp    al,neutral_marker
    jne    trace_invoke_1
    mov    al,"#"
    call    printchar
trace_invoke_1:
    mov    al,"#"
    call    printchar
    mov    al,"("
    call    printchar
trace_invoke_3:
    mov    si,di
    mov    di,[di]
    cmp    si,di        ;at end?
    je    trace_invoke_2    ;yes.
    mov    cx,di
    sub    cx,si
    sub    cx,mark_overhead    ;remove overhead.
    add    si,mark_overhead-1        ;skip past overhead.
    jcxz    trace_invoke_5
trace_invoke_4:
    lodsb
    call    printchar
    loop    trace_invoke_4
trace_invoke_5:
    cmp    di,[di]            ;last argument?
    je    trace_invoke_3        ;yes - don't print comma.
    mov    al,","
    call    printchar
    jmp    trace_invoke_3
trace_invoke_2:
    mov    al,")"
    call    printchar
    pop    di
    pop    dx
    pop    bx
trace_invoke_6:
    ret


printchar:
    mov    dl,al
    mov    ah,6
    int    21h
    ret


redirect:
;enter with bx = device to redirect (0..2).
;exit with ax = new flag for this device.
    mov    cx,bx            ;get the filename.
    add    cx,3
    call    getarg_filename
    je    redirect_1        ;no filename - don't redirect.

    mov    ah,45h            ;make a copy of handle in bx
    int    21h            ;  into ax.

    push    ax            ;remember the old handle.
    mov    ah,3eh            ;close the original handle.
    int    21h
    mov    ax,3d00h        ;open for reading.
    cmp    bx,0            ;redirecting from stdin?
    je    redirect_2
    mov    ah,3ch            ;no - we have to create it.
    xor    cx,cx
redirect_2:
    mov    dx,si            ;point to the filename.
    int    21h            ;either open or create.
    jc    redirect_3        ;go if we failed to open it.
    pop    ax            ;get the old handle back.
    ret
redirect_3:
    mov    cx,bx            ;get the original handle (now closed).
    pop    bx            ;get the copy of the original handle.
    mov    ah,46h            ;copy the bx handle to cx.
    int    21h
    mov    ah,3eh            ;now close the copy.
    int    21h
redirect_1:
    mov    ax,-1            ;say that there is no file open.
    ret


unredirect:
;enter with bx = stdxxx file number, cx = handle to restore.
    cmp    cx,-1
    je    unredirect_1

    mov    ah,3eh            ;close stdxxx file.
    int    21h

    xchg    bx,cx            ;force the original handle back.
    mov    ah,46h
    int    21h

    mov    ah,3eh            ;close the copy.
    int    21h
unredirect_1:
    ret


ex_prim:
    mov    bx,0
    call    redirect
    mov    ex_stdin,ax

    mov    bx,1
    call    redirect
    mov    ex_stdout,ax

    mov    cx,4
    call    getarg            ;get the fourth argument
    mov    dx,cx            ;save size of fourth argument
    mov    di,si            ;save pointer to fourth argument
    mov    cx,5            ;get fifth argument
    call    getarg
    jcxz    ex_prim_2        ;if the fifth argument is empty, we're done.
    cmp    cx,dx            ;lengths equal?
    jne    ex_prim_2        ;no, separate redirect.
    repe    cmpsb            ;strings equal?
    jne    ex_prim_2        ;no, separate redirect.

    mov    bx,2
    mov    ah,45h            ;make a copy of handle in bx
    int    21h            ;  into ax.
    mov    ex_stderr,ax        ;remember it.

    mov    ah,3eh            ;close the original handle.
    int    21h
    mov    bx,1            ;now dup stdout into stderr.
    mov    ah,45h            ;make a copy of handle in bx
    int    21h            ;  into ax.
    jmp    short ex_prim_3

ex_prim_2:
    mov    bx,2
    call    redirect
    mov    ex_stderr,ax
ex_prim_3:

    push    swap_screen_flag
    mov    ax,ex_stdout
    or    ax,ex_stderr
    cmp    ax,-1            ;are we redirecting both of them?
    je    ex_prim_1        ;no.
    mov    swap_screen_flag,0    ;yes - don't swap screens.
ex_prim_1:

    call    getarg1_filename
    push    si
    mov    cx,2
    call    getarg
    pop    di
    call    execute_program
    pop    swap_screen_flag

    di_points_fbgn

    push    ax
    mov    bx,0
    mov    cx,ex_stdin
    call    unredirect

    mov    bx,1
    mov    cx,ex_stdout
    call    unredirect

    mov    bx,2
    mov    cx,ex_stderr
    call    unredirect
    pop    ax

    jmp    return_number

    extrn    execute_program: near

    extrn    get_key_value: near
    extrn    decode_key: near
    extrn    buffer_insert: near

    extrn    return_arg: near
    extrn    return_number: near
    extrn    return_null: near
    extrn    return_sicx: near
    extrn    return_tos: near
    extrn    return_arg_active: near
    extrn    return_string: near
    extrn    make_active: near
    extrn    getarg1_filename: near
    extrn    getarg_filename: near
    extrn    getarg1: near
    extrn    getarg: near
    extrn    get_decimal_arg1: near
    extrn    get_decimal_arg: near
    extrn    get_decimal: near
    extrn    get_number: near
    extrn    put_number: near

;the following externs are defined in mintprim.asm
    extrn    dflt: near
    extrn    hl_prim: near
    extrn    eq_prim: near
    extrn    nc_prim: near
    extrn    db_prim: near
    extrn    ct_prim: near
    extrn    st_prim: near
;forms
    extrn    ds_prim: near
    extrn    mp_prim: near
    extrn    gs_prim: near
    extrn    go_prim: near
    extrn    gn_prim: near
    extrn    rs_prim: near
    extrn    fm_prim: near
    extrn    ev_prim: near
    extrn    ls_prim: near
    extrn    es_prim: near
    extrn    sl_prim: near
    extrn    ll_prim: near
    extrn    nb_prim: near
    extrn    si_prim: near
;math
    extrn    ad_prim: near
    extrn    su_prim: near
    extrn    ml_prim: near
    extrn    dv_prim: near
    extrn    md_prim: near
    extrn    and_prim: near
    extrn    or_prim: near
    extrn    xor_prim: near
    extrn    gr_prim: near

    public    ex_prim
    public    sc_prim

    public    rd_prim
    public    it_prim

    public    sa_prim
    public    is_prim
    public    bc_prim
    public    sv_prim
    public    lv_prim
    public    pp_prim
    public    bl_prim
    public    sm_prim
    public    sp_prim
    public    dm_prim
    public    rm_prim
    public    rc_prim
    public    mb_prim
    public    lp_prim
    public    rf_prim
    public    wf_prim
    public    an_prim
    public    ow_prim
    public    xy_prim
    public    pm_prim
    public    ba_prim
    public    bi_prim
    public    ff_prim
    public    rn_prim
    public    de_prim
  if timing
    public    ec_prim
  endif
  if test_prims
    public    ts_prim
    public    tt_prim
  endif


code    ends

data    segment    byte public
    public    function_name_table
    public    function_name_length
    public    function_address

function_name_table    label    word
    db    'rd'
    db    'it'

    db    '=='            ;equals
    db    'nc'            ;number of characters
    db    'ct'            ;convert time
    db    'a?'            ;alphabetic ordered?
    db    'sa'            ;sort ascending
;forms
    db    'ds'            ;define string
    db    'mp'            ;make parameter
    db    'gs'            ;get string
    db    'go'            ;get one
    db    'gn'            ;get n
    db    'rs'            ;reset string
    db    'fm'            ;first match
    db    'ev'            ;read enviornment
    db    'ls'            ;list strings
    db    'es'            ;erase string
    db    'sl'            ;save library
    db    'll'            ;load library
    db    'n?'            ;name exists?
    db    'si'            ;string index
;math
    db    '++'            ;add
    db    '--'            ;subtract
    db    '**'            ;multiply
    db    '//'            ;divide
    db    '%%'            ;modulus
    db    '||'            ;or
    db    '&&'            ;and
    db    '^^'            ;xor
    db    'g?'            ;numeric greater

    db    'is'            ;insert string
    db    'bc'            ;base conversion
    db    'sv'            ;set variable
    db    'lv'            ;load variable
    db    'pp'            ;pick position
    db    'bl'            ;bell
    db    'sm'            ;set mark
    db    'sp'            ;set point
    db    'dm'            ;del to mark
    db    'rm'            ;read to mark
    db    'rc'            ;read count
    db    'mb'            ;mark before
    db    'lp'            ;look pattern
    db    'l?'            ;look&test
    db    'rf'            ;read file
    db    'wf'            ;write file
    db    'an'            ;announce
    db    'ow'            ;overwrite
    db    'xy'            ;gotoxy
    db    'pm'            ;push/pop mark
    db    'ba'            ;buffer allocate
    db    'bi'            ;buffer insert
    db    'ff'            ;find files
    db    'rn'            ;rename file
    db    'de'            ;delete file
    db    'st'            ;syntax table
    db    'hl'            ;halt
    db    'db'            ;debug
    db    'tr'            ;translate
    db    'ex'            ;execute
    db    'sc'            ;spell check
  if timing
    db    'ec'
  endif
  if test_prims
    db    'ts'
    db    'tt'
  endif

function_name_length    equ ($-function_name_table)/2

    dw    dflt
function_address    label    word
    dw    rd_prim        ;redisplay
    dw    it_prim        ;input timed.
    dw    eq_prim
    dw    nc_prim
    dw    ct_prim
    dw    ao_prim
    dw    sa_prim
;forms
    dw    ds_prim
    dw    mp_prim
    dw    gs_prim
    dw    go_prim
    dw    gn_prim
    dw    rs_prim
    dw    fm_prim
    dw    ev_prim
    dw    ls_prim
    dw    es_prim
    dw    sl_prim
    dw    ll_prim
    dw    nb_prim
    dw    si_prim
;math
    dw    ad_prim
    dw    su_prim
    dw    ml_prim
    dw    dv_prim
    dw    md_prim
    dw    or_prim
    dw    and_prim
    dw    xor_prim
    dw    gr_prim

    dw    is_prim        ;insert string
    dw    bc_prim        ;base convert
    dw    sv_prim        ;set variable
    dw    lv_prim        ;load variable
    dw    pp_prim        ;pick position
    dw    bl_prim        ;bell
    dw    sm_prim        ;set mark
    dw    sp_prim        ;set point
    dw    dm_prim        ;delete to mark
    dw    rm_prim        ;read to mark
    dw    rc_prim        ;count to mark
    dw    mb_prim        ;mark before
    dw    lp_prim        ;look pattern
    dw    lt_prim        ;look&test
    dw    rf_prim        ;read file
    dw    wf_prim        ;write file
    dw    an_prim        ;announce
    dw    ow_prim        ;overwrite
    dw    xy_prim        ;gotoxy
    dw    pm_prim        ;push/pop mark
    dw    ba_prim        ;buffer allocate
    dw    bi_prim        ;buffer insert
    dw    ff_prim        ;find first/next
    dw    rn_prim        ;rename file
    dw    de_prim        ;delete file
    dw    st_prim        ;set the syntax table.
    dw    hl_prim
    dw    db_prim
    dw    tr_prim
    dw    ex_prim
    dw    sc_prim
  if timing
    dw    ec_prim
  endif
  if test_prims
    dw    ts_prim        ;test
    dw    tt_prim        ;test two
  endif

data    ends


    end